home *** CD-ROM | disk | FTP | other *** search
Text File | 1987-08-13 | 3.2 KB | 145 lines | [TEXT/PJMM] |
- { AppFont - Application Font Control by Steve Sheets }
- { Control Panel Proc to change the Application Font }
-
- UNIT AFunit;
-
- INTERFACE
-
- FUNCTION Main (message, item, numitems, CPanel : integer;
- theEvent : EventRecord;
- cdevStorage : longint;
- CPDialog : DialogPtr) : longint;
-
- IMPLEMENTATION
-
- { Given the DialogPtr to the Control Panel, and the number of items in the}
- { original Control Panel DITL and the Number of the Font Button to be}
- { selected, selects that Font Button and unselects all the other Buttons.}
- PROCEDURE DoHit (N, X : integer;
- CP : DialogPtr);
- VAR
- count : integer;
- myT : integer;
- myH : handle;
- myR : rect;
- BEGIN
- FOR count := X + 1 TO X + 16 DO
- BEGIN
- GetDItem(CP, count, myT, myH, MyR);
- IF count = N THEN
- SetCtlValue(Controlhandle(myH), 1)
- ELSE
- SetCtlValue(Controlhandle(myH), 0);
- END;
- END;
-
- { First finds the current Application Font ID number, converts that ID number}
- { into corresponding Font Button number and returns that number.}
- FUNCTION CurNum : integer;
- VAR
- SP : SysPPtr;
- V : integer;
- BEGIN
- SP := GetSysPPtr;
- V := SP^.Font + 1;
-
- CASE V OF
- 0 :
- CurNum := 1;
- 2, 3, 4, 5, 6, 7, 8, 9 :
- CurNum := V;
- 11, 12 :
- CurNum := V - 1;
- 20, 21, 22, 23, 24 :
- CurNum := V - 8;
- OTHERWISE
- CurNum := 0;
- END;
- END;
-
- { Given the Font Button number, converts it into the Application Font ID number,}
- { then sets the current Application Font to that number.}
- PROCEDURE SetNum (N : integer);
- VAR
- SP : SysPPtr;
- E : OSErr;
- V : integer;
- BEGIN
- CASE N OF
- 1 :
- V := 0;
- 2, 3, 4, 5, 6, 7, 8, 9 :
- V := N;
- 10, 11 :
- V := N + 1;
- 12, 13, 14, 15, 16 :
- V := N + 8;
- OTHERWISE
- V := Geneva;
- END;
- SP := GetSysPPtr;
- SP^.Font := V - 1;
- E := WriteParam;
- END;
-
- { For all the Font Buttons, checks to see if that Font is installed in the system.}
- { If it is not installed, unhilites the corresponding button so it can not be}
- { selected.}
- PROCEDURE ZapFonts (CP : DialogPtr;
- N : integer);
- VAR
- count, F : integer;
- S : str255;
- myT : integer;
- myH : handle;
- myR : rect;
- BEGIN
- FOR count := 1 TO 16 DO
- BEGIN
- CASE count OF
- 1 :
- F := 0;
- 2, 3, 4, 5, 6, 7, 8, 9 :
- F := count;
- 10, 11 :
- F := count + 1;
- 12, 13, 14, 15, 16 :
- F := count + 8;
- OTHERWISE
- END;
- GetFontName(F, S);
- GetDItem(CP, N + count, myT, myH, MyR);
- IF S = '' THEN
- HiliteControl(ControlHandle(myH), 255)
- ELSE
- HiliteControl(ControlHandle(myH), 0);
- END;
- END;
-
- { cdev Main Function. Handles InitDev call (Zaps all the unistalled Font Buttons}
- { and selects the current Font Button) and the HitDev calls (selects the}
- { pressed Font Buttons and sets the Application Font to that Font.}
- FUNCTION Main;
- VAR
- Val : longint;
- BEGIN
- IF (cdevStorage <> 0) AND (cdevStorage <> 1) AND (cdevStorage <> -1) THEN
- BEGIN
- CASE Message OF
- 0 : {InitDev}
- BEGIN
- ZapFonts(CPDialog, numitems);
- DoHit(CurNum + numitems, numitems, CPDialog);
- END;
- 1 : {HitDev}
- BEGIN
- DoHit(item, numitems, CPDialog);
- SetNum(item - numitems);
- END;
- OTHERWISE
- END;
- END;
- Main := cdevStorage;
- END;
-
- END.